home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / sprites / mchsprt.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  26KB  |  843 lines
  1. unit MChSprt;
  2.  
  3. {  
  4.                        Real Time Scaleable Sprites 
  5.                               Components 
  6.                                  for 
  7.                             Borland Delphi
  8.  
  9.                           Copyright 1995 by
  10.                          Marek A. Chmielowski
  11.                          All rights reserved
  12.  
  13. These components and source code is released to the public domain under the condition
  14.  that it will not be used for commercial or "For Profit" ventures. 
  15. This code can be copied, used, and distributed freely providing that it is NOT 
  16. modified, no fee is charged, and it is not used in a package for which a charge 
  17. is made.
  18.  
  19. Please do NOT distribute components or source code if you altered them - 
  20.                     EVEN IF THIS IS ONLY BUG CORRECTION.  
  21. Let me know about the problem and the solution and I will implement it in the 
  22. next version (may be it will be the next version).  
  23. My e-mail:  
  24.                        76360,2775@compuserve.com
  25.  
  26. If you would like to use this component for shareware or commercial application 
  27. please contact me first by mail:
  28.                           
  29.                           Marek Chmielowski
  30.                           5/56 Kozia St.
  31.                           Warsaw 00-070
  32.                           Poland   
  33.                                   or
  34.  
  35.                           Marek Chmielowski
  36.                           10005 Broad St. 
  37.                           Bethesda, MD 20814
  38.                           USA
  39.  
  40.                           
  41. }
  42.  
  43. interface
  44.  
  45. uses
  46.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  47.   Forms, Dialogs, ExtCtrls, Buttons, StdCtrls, MChSpBg;
  48.  
  49. type 
  50.   TMChSprite = class;
  51.  
  52.   TSprPosFunc = function(AtTime: TDateTime):TPoint;
  53.   TSprOnBorder = procedure(AtTime: TDateTime);
  54.   TSprOnCollide = procedure(SprCollided: TMChSprite; AtTime: TDateTime);
  55.   TSprNoCollide = procedure(AtTime: TDateTime);
  56.  
  57.   TMChSprite = class(TGraphicControl)
  58.     { Public declarations or Published if $M+ }
  59.   private
  60.     { Private declarations }
  61.     PSpriteMgr: TMChSpriteBgr;
  62.     FSprMgrSet: Boolean;
  63.     FSprBitmapOrig: TBitmap;
  64.     FSprTrColor: TColor;
  65.     FSprBitmap, FSprMask: TBitmap;
  66.     FSprBitSet: Boolean;
  67.     FSprSet: Boolean;
  68.     FSprOnCanvas: Boolean;
  69.     FSprInBuf: Boolean;
  70.     FSprToShow: Boolean;
  71.     FSprRepaint: Boolean;
  72.     FSprRunning: Boolean;
  73.     FSprPaused: Boolean;
  74.     FSprCruise: Boolean;
  75.     FSprFrom: TPoint;
  76.     FSprDest: TPoint;
  77.     FSprNextPos: TPoint;
  78.     FSprMoved: Boolean;
  79.     FSprCurrentRect: TRect;
  80.     FSprDirty: TDirtyReg;
  81.     FSprTimeToRun: TDateTime;
  82.     FSprHideAfter: Boolean;
  83.     FSprTimeRunning: TDateTime;
  84.     FSprTimeStarted: TDateTime;
  85.     FSprTimeUpdated: TDateTime;
  86.     FSprMoveVect: TPoint;
  87.     FSprPosFunc: TSprPosFunc;
  88.     FSprIndex: Cardinal;
  89.     FSprDragable: Boolean;
  90.     FSprScaleX: double;
  91.     FSprScaleY: double;
  92.     FSprRescale: Boolean;
  93.     FSprRefX: Integer;
  94.     FSprRefY: Integer;
  95.     FSprColliding: Boolean;
  96.     FSprCollisionMask: Boolean;
  97.     FSprRadiusX: Integer;
  98.     FSprRadiusY: Integer;
  99.     FSprGuessBgr: Boolean;
  100.     procedure SprSetBitmap(Bitmap: TBitmap; trColor: TColor);
  101.     procedure SprMakeMask(trColor: TColor);
  102.     procedure SprReplTrCl(trColor: TColor);
  103.     function  SprMakeVect(From, Dest: TPoint):TPoint;
  104.     procedure SprGuessSpriteMgr;
  105.     procedure SprFreeNotOrig;
  106.   protected
  107.     { Protected declarations }
  108.     procedure SprFree;
  109.   public
  110.     { Public declarations }
  111.     FSprOnCollide: TSprOnCollide;
  112.     FSprOnBorder: TSprOnBorder;
  113.     FSprNoCollide: TSprNoCollide;
  114.     constructor Create(AOwner: TComponent); override;
  115.     destructor  Destroy; override;
  116.     procedure SprInit;
  117.     procedure SprSetMgr(BgrMgr: TMChSpriteBgr);
  118.     procedure SprUnSetMgr;
  119.     procedure SprSetBitmapOrig(Bitm: TBitmap);
  120.     procedure SprRenewBitmap;
  121.     procedure SprSetTrColor(trColor: TColor);
  122.     procedure SprShowAt(Dest: TPoint);
  123.     procedure SprShowPaused(Dest: TPoint);
  124.     procedure SprShowAtTime(JTime: TDateTime);
  125.     procedure SprShowOn;
  126.     procedure SprHide;
  127.     procedure SprHideTmp;
  128.     procedure SprStop;
  129.     function  SprDesiredPos(AtTime: TDateTime):TPoint;
  130.     procedure SprGoTo(Dest: TPoint; TimeToRunSec: TDateTime);
  131.     procedure SprGo(From, Dest: TPoint; TimeToRunSec: TDateTime);
  132.     procedure SprRun(From,Dest: TPoint; TimeToRunSec: TDateTime);
  133.     procedure SprCruise(TimeToRunSec: TDateTime);
  134.     procedure SprMoveTo(Dest: TPoint);
  135.     function  SprGetDirty: TDirtyReg;
  136.     function  SprGetDirtyAndClear: TDirtyReg;
  137.     function  SprHitTest(ScrP: TPoint): Boolean;
  138.     function  SprHitAt(ScrP: TPoint): TPoint;
  139.     procedure SprSetScale(NewScale: double);
  140.     procedure SprSetScaleX(NewScaleX: double);
  141.     procedure SprSetScaleY(NewScaleY: double);
  142.     procedure SprSetRef(NewRef: TPoint);
  143.     procedure SprSetRefX(NewRefX: Integer);
  144.     procedure SprSetRefY(NewRefY: Integer);
  145.     function  SprRefToLeftTop(ScrP: TPoint): TPoint;
  146.     function  SprLeftTopToRef(ScrP: TPoint): TPoint;
  147.     function  SprCheckCollision(TestSpr: TMChSprite; AtTime: TDateTime): Boolean;
  148.     function  SprCheckBorders(AtTime: TDateTime): Boolean;
  149.     property  SprPosFunc: TSprPosFunc read FSprPosFunc write FSprPosFunc;
  150.     property  SprMask: TBitmap read FSprMask;
  151.     property  SprBitmap: TBitmap read FSprBitmap;
  152.     property  SprFrom: TPoint read FSprFrom;
  153.     property  SprDest: TPoint read FSprDest;
  154.     property  SprNextPos: TPoint read FSprNextPos;
  155.     property  SprCurrentRect: TRect read FSprCurrentrect; 
  156.     property  SprInBuf: Boolean read FSprInBuf;
  157.     property  SprOnCanvas: Boolean read FSprOnCanvas;
  158.     property  SprRepaint: Boolean read FSprRepaint write FSprRepaint;
  159.     property  SprIndex: Cardinal read FSprIndex write FSprIndex;
  160.     property  SprOnCollide: TSprOnCollide read FSprOnCollide write FSprOnCollide;
  161.     property  SprOnBorder: TSprOnBorder read FSprOnBorder write FSprOnBorder;
  162.     property  SprNoCollide: TSprNoCollide read FSprNoCollide write FSprNoCollide;
  163.     property  SprTimeUpdated: TDateTime read FSprTimeUpdated;
  164.     property  SprTimeStarted: TDateTime read FSprTimeStarted;
  165.     property  SprPaused: Boolean read FSprPaused write FSprPaused;
  166.     property  SprCollisionMask: Boolean read FSprCollisionMask write FSprCollisionMask;
  167.   published
  168.     { Published declarations - can be only class type or properties }
  169.     property  Visible;
  170.     property  Height default 1;
  171.     property  Width default 1;
  172.     property  Left;
  173.     property  Top;
  174.     property  SprSpriteBitmap: TBitmap read FSprBitmapOrig write SprSetBitmapOrig;
  175.     property  SprTrColor: TColor read FSprTrColor write SprSetTrColor;
  176.     property  SprHideAfter: Boolean read FSprHideAfter write FSprHideAfter default False;
  177.     property  SprScaleX: double read FSprScaleX write SprSetScaleX;
  178.     property  SprScaleY: double read FSprScaleY write SprSetScaleY;
  179.     property  SprRefX: Integer read FSprRefX write SprSetRefX;
  180.     property  SprRefY: Integer read FSprRefY write SprSetRefY;
  181.     property  SprColliding: Boolean read FSprColliding write FSprColliding; 
  182.     property  SprRadiusX: Integer read FSprRadiusX write FSprRadiusX;
  183.     property  SprRadiusY: Integer read FSprRadiusY write FSprRadiusY;
  184.     property  SprGuessBgr: Boolean read FSprGuessBgr write FSprGuessBgr default False;
  185.     property  SprDragable: Boolean read FSprDragable write FSprDragable default False;
  186.   end;
  187.  
  188. procedure Register;
  189.  
  190. implementation
  191.  
  192. procedure Register;
  193.   begin
  194.   RegisterComponents('Samples', [TMChSprite]);
  195.   end;
  196.  
  197. constructor TMChSprite.Create(AOwner: TComponent);
  198.   begin
  199.   inherited Create(AOwner);
  200.   Visible:=False;
  201.   FSprBitmapOrig:=TBitmap.Create;  
  202.   FSprCurrentRect:=Rect(Left,Top,Left+Width,Top+Height);
  203.   FSprTimeStarted:=time;
  204.   FSprNextPos:=Point(Left,Top);
  205.   FSprGuessBgr:=True;
  206.   FSprScaleX:=1.0;
  207.   FSprScaleY:=1.0;
  208.   end;
  209.  
  210. destructor TMChSprite.Destroy;
  211.   begin
  212.   SprFree;
  213.   inherited Destroy;
  214.   end;
  215.  
  216. procedure TMChSprite.SprFreeNotOrig;
  217.   begin
  218.   try
  219.     if FSprRunning then SprStop;
  220.     if FSprOnCanvas then SprHide;
  221.     FSprMask.Free;
  222.     FSprBitmap.Free;
  223.   finally
  224.     FSprBitSet:=False;
  225.     end;
  226.   end;
  227.  
  228. procedure TMChSprite.SprFree;
  229.   begin
  230.   SprFreeNotOrig;
  231.   FSprBitmapOrig.Free;
  232.   end;
  233.  
  234. procedure TMChSprite.SprInit;
  235.   begin
  236.   if not FSprMgrSet then SprGuessSpriteMgr;
  237.   if not FSprBitSet then SprRenewBitmap;
  238.   FSprSet:=True;
  239.   end;
  240.  
  241. procedure TMChSprite.SprSetMgr(BgrMgr: TMChSpriteBgr);
  242.   begin
  243.   PSpriteMgr:=BgrMgr;
  244.   FSprMgrSet:=True;
  245.   SprInit;
  246.   end;
  247.  
  248. procedure TMChSprite.SprUnSetMgr;
  249.   begin
  250.   if FSprRunning then SprStop;
  251.   SprHide;
  252.   SprHideTmp;
  253.   FSprDirty.Old:=FSprCurrentRect;
  254.   FSprDirty.New:=NulRect;
  255.   FSprOnCanvas:=False;
  256.   PSpriteMgr.BgrUpdateDirtyReg(SprGetDirty);
  257.   PSpriteMgr:=nil;
  258.   FSprIndex:=0;
  259.   FSprMgrSet:=False;
  260.   FSprSet:=False;
  261.   end;
  262.  
  263. procedure TMChSprite.SprGuessSpriteMgr;
  264.   var
  265.     i: Cardinal;
  266.   begin
  267.   if not FSprGuessBgr then Exit;
  268.   if Parent.ComponentCount>0 then
  269.     begin
  270.     for i:=0 to Parent.ComponentCount-1 do
  271.       begin
  272.       if Parent.Components[i] is TMChSpriteBgr then
  273.         begin
  274.         PSpriteMgr:=(Parent.Components[i] as TMChSpriteBgr);
  275.         FSprMgrSet:=True;
  276.         Break;
  277.         end;
  278.       end;
  279.     end;
  280.   end;
  281.  
  282. procedure TMChSprite.SprMakeMask(trColor: TColor);
  283.   var
  284.     ColTestBitm1,ColTestBitm2: TBitmap;
  285.     trColorInv: TColor;
  286.   begin
  287.   { Used to find result of xor for colors on actual bitmap }
  288.   ColTestBitm1 := TBitmap.Create;
  289.   ColTestBitm1.width := 1;
  290.   ColTestBitm1.height:=1;
  291.   ColTestBitm2 := TBitmap.Create;
  292.   ColTestBitm2.width := 1;
  293.   ColTestBitm2.height:=1;
  294.   ColTestBitm1.Canvas.Pixels[0,0]:=trColor;
  295.   ColTestBitm2.Canvas.CopyMode:=cmSrcInvert;
  296.   ColTestBitm2.Canvas.Draw(0,0,ColTestBitm1);
  297.   trColorInv:=ColTestBitm2.Canvas.Pixels[0,0];
  298.   ColTestBitm1.free;
  299.   ColTestBitm2.free;
  300.   with SprMask.Canvas do
  301.     begin
  302.     { Does NOT work well due to color mapping }
  303.     {Brush.Color:= ((trColor xor clWhite) and $00FFFFFF)
  304.                    or (trColor and $0F000000);}
  305.     Brush.Color:= trColorInv;
  306.     BrushCopy( Rect(0,0,SprMask.Width,SprMask.Height),
  307.                FSprBitmap,
  308.                Rect(0,0,FSprBitmap.Width,FSprBitmap.Height),
  309.                trColor);
  310.     CopyMode:=cmSrcInvert;  { src xor Dest) }
  311.     Draw(0,0,FSprBitmap);
  312.     end;
  313.   end;
  314.  
  315. procedure TMChSprite.SprReplTrCl(trColor: TColor);
  316.   begin
  317.   with FSprBitmap.Canvas do
  318.     begin
  319.     CopyMode:=cmSrcCopy;
  320.     Brush.Color:= clBlack;
  321.     BrushCopy( Rect(0,0,FSprBitmap.Width,FSprBitmap.Height),
  322.                FSprBitmap,
  323.                Rect(0,0,FSprBitmap.Width,FSprBitmap.Height),
  324.                trColor);
  325.     end;
  326.   end;
  327.  
  328. procedure TMChSprite.SprSetBitmap(Bitmap: TBitmap; trColor: TColor);
  329.   begin
  330.   if not FSprMgrSet then SprGuessSpriteMgr;
  331.   try
  332.     SprFreeNotOrig;
  333.     FSprTrColor:=trColor;
  334.     if not Bitmap.Empty then
  335.       begin
  336.       Width :=Bitmap.Width;
  337.       Height:=Bitmap.Height;
  338.       FSprBitmap   := TBitmap.Create;
  339.       FSprMask     := TBitmap.Create;
  340.       FSprBitmap.Width    := Bitmap.Width;
  341.       FSprBitmap.Height   := Bitmap.Height;
  342.       FSprMask.Width      := Bitmap.Width;
  343.       FSprMask.Height     := Bitmap.Height;
  344.       FSprBitmap.Canvas.Draw(0,0,Bitmap);
  345.       SprMakeMask(trColor);
  346.       SprReplTrCl(trColor);
  347.       FSprScaleX:=1.0;
  348.       FSprScaleY:=1.0;
  349.       FSprRefX:=Width div 2;
  350.       FSprRefY:=Height div 2;
  351.       FSprRadiusX:=Width div 2;
  352.       FSprRadiusY:=Height div 2;
  353.       FSprCurrentRect:=Rect(Left,Top,Left+Width,Top+Height);
  354.       FSprNextPos:=Point(Left+round(FSprRefX*FSprScaleX),Top+round(FSprRefY*FSprScaleY));
  355.       FSprBitSet:=True;
  356.       end;
  357.   except
  358.     SprFreeNotOrig;
  359.     end;
  360.   end;
  361.  
  362. procedure TMChSprite.SprSetTrColor(trColor: TColor);
  363.   begin
  364.   FSprTrColor:=trColor;
  365.   SprRenewBitmap;
  366.   end;
  367.  
  368. procedure TMChSprite.SprRenewBitmap;
  369.   begin
  370.   SprSetBitmap(FSprBitmapOrig,FSprTrColor);
  371.   end;
  372.  
  373. procedure TMChSprite.SprSetBitmapOrig(Bitm: TBitmap);
  374.   begin
  375.   Width :=Bitm.Width;
  376.   Height:=Bitm.Height;
  377.   FSprBitmapOrig.Width  := Bitm.Width;
  378.   FSprBitmapOrig.Height := Bitm.Height;
  379.   FSprBitmapOrig.Canvas.Draw(0,0,Bitm);
  380.   SprRenewBitmap;
  381.   end;
  382.  
  383. procedure TMChSprite.SprHide;
  384.   begin
  385.   if FSprOnCanvas then 
  386.     begin
  387.     FSprToShow:=False;
  388.     end;
  389.   end;
  390.  
  391. procedure TMChSprite.SprHideTmp;
  392.   begin
  393.   if not FSprMgrSet then SprGuessSpriteMgr;
  394.   if FSprInBuf then PSpriteMgr.BgrEraseBufRect(FSprCurrentRect);
  395.   FSprInBuf:=False;
  396.   end;
  397.  
  398. procedure TMChSprite.SprStop;
  399.   begin
  400.   FSprCruise:=False;
  401.   if FSprRunning then
  402.     begin
  403.     if FSprHideAfter then SprHide;
  404.     FSprRunning:=False;
  405.     end;
  406.   end;
  407.  
  408. function  TMChSprite.SprGetDirty: TDirtyReg;
  409.   begin
  410.   SprGetDirty:=FSprDirty;
  411.   end;
  412.  
  413. function  TMChSprite.SprGetDirtyAndClear: TDirtyReg;
  414.   begin
  415.   SprGetDirtyAndClear:=FSprDirty;
  416.   FSprDirty.Old:=NulRect;
  417.   FSprDirty.New:=NulRect;
  418.   end;
  419.  
  420. procedure TMChSprite.SprMoveTo(Dest: TPoint);
  421.   begin
  422.   FSprCruise:=False;
  423.   if FSprRunning then SprStop;
  424.   SprHide;
  425.   FSprNextPos:=Dest;
  426.   FSprTimeUpdated:=time;
  427.   FSprMoved:=True;
  428.   FSprTimeUpdated:=time;
  429.   end;
  430.  
  431. procedure TMChSprite.SprShowOn;
  432.   begin
  433.   if FSprMoved then SprShowAT(FSprNextPos)
  434.   else SprShowAT(SprLeftTopToRef(Point(Left,Top)));
  435.   end;
  436.  
  437. procedure TMChSprite.SprShowAt(Dest: TPoint);
  438.   begin
  439.   FSprCruise:=False;
  440.   if not FSprSet then SprInit;
  441.   if FSprRunning then SprStop;
  442.   FSprNextPos:=Dest;
  443.   FSprMoved:=True;
  444.   FSprToShow:=True;
  445.   FSprTimeUpdated:=time;
  446.   end;
  447.  
  448.  
  449. procedure TMChSprite.SprShowPaused(Dest: TPoint);
  450.   begin
  451.   if not FSprSet then SprInit;
  452.   FSprNextPos:=Dest;
  453.   FSprMoved:=True;
  454.   FSprToShow:=True;
  455.   FSprTimeUpdated:=time;
  456.   end;
  457.  
  458. procedure TMChSprite.SprShowAtTime(JTime: TDateTime);
  459.   var
  460.     RcOld: TRect;
  461.     Stationary: Boolean;
  462.     NewPos: TPoint;
  463.   begin
  464.   if not FSprSet then SprInit;
  465.   if FSprToShow then
  466.     begin
  467.     RcOld:=FSprCurrentRect;
  468.     FSprTimeRunning:=JTime-FSprTimeStarted;
  469.     NewPos:= SprDesiredPos(JTime);
  470.     if FSprMoved then FSprMoved:=False;
  471.     if FSprOnCanvas and ((Left+SprRefX)=NewPos.x) and ((Top+SprRefY)=NewPos.y) and (not FSprRescale) then
  472.       Stationary:=True
  473.     else
  474.       begin
  475.       Stationary:=False;
  476.       Left:=SprRefToLeftTop(NewPos).x;
  477.       Top :=SprRefToLeftTop(NewPos).y;
  478.       Width :=round(SprBitmap.Width *FSprScaleX);
  479.       Height:=round(SprBitmap.Height*FSprScaleY);
  480.       FSprCurrentRect:=Rect(Left,Top,Left+Width,Top+Height);
  481.       FSprRescale:=False;
  482.       FSprNextPos:=NewPos;
  483.       FSprTimeUpdated:=JTime;
  484.       end;
  485.     {
  486.     PSpriteMgr.BgrScreenBuf.Canvas.CopyMode:=cmSrcAnd;
  487.     PSpriteMgr.BgrScreenBuf.Canvas.StretchDraw(FSprCurrentRect,FSprMask);
  488.     PSpriteMgr.BgrScreenBuf.Canvas.CopyMode:=cmSrcPaint;
  489.     PSpriteMgr.BgrScreenBuf.Canvas.StretchDraw(FSprCurrentRect,FSprBitmap);
  490.     }
  491.     PSpriteMgr.BgrScreenBufStretchMaskPaint(FSprCurrentRect,FSprMask,FSprBitmap);
  492.     FSprInBuf:=True;
  493.     if not Stationary then
  494.       begin
  495.       if FSprOnCanvas then FSprDirty.Old:=RcOld;
  496.       FSprDirty.New:=FSprCurrentRect;
  497.       end
  498.     else if SprRepaint then FSprDirty.New:=FSprCurrentRect;
  499.     FSprOnCanvas:=True;
  500.     if FSprHideAfter and (FSprTimeToRun>0) and ((JTime-FSprTimeStarted)>FSprTimeToRun) then
  501.       begin
  502.       FSprToShow:=False;
  503.       end;
  504.     end
  505.   else
  506.     begin
  507.     if FSprOnCanvas then
  508.       begin
  509.       FSprDirty.Old:=FSprCurrentRect;
  510.       FSprDirty.New:=NulRect;
  511.       FSprOnCanvas:=False;
  512.       end
  513.     else
  514.       begin
  515.       if FSprRunning and not FSprToShow then
  516.         begin
  517.         FSprTimeRunning:=JTime-FSprTimeStarted;
  518.         NewPos:= SprDesiredPos(JTime);
  519.         if FSprMoved then FSprMoved:=False;
  520.         Left:=SprRefToLeftTop(NewPos).x;
  521.         Top :=SprRefToLeftTop(NewPos).y;
  522.         Width :=round(SprBitmap.Width *FSprScaleX);
  523.         Height:=round(SprBitmap.Height*FSprScaleY);
  524.         FSprCurrentRect:=Rect(Left,Top,Left+Width,Top+Height);
  525.         FSprNextPos:=NewPos;
  526.         FSprTimeUpdated:=JTime;
  527.         end;
  528.       end;
  529.     end;
  530.   end;
  531.  
  532. procedure TMChSprite.SprGoTo(Dest: TPoint; TimeToRunSec: TDateTime);
  533.   begin
  534.   SprGo(SprLeftTopToRef(Point(Left,Top)),Dest,TimeToRunSec);
  535.   end;
  536.  
  537. procedure TMChSprite.SprGo(From, Dest: TPoint; TimeToRunSec: TDateTime);
  538.   begin
  539.   FSprCruise:=False;
  540.   if not FSprSet then SprInit;
  541.   if FSprRunning then SprStop;
  542.   FSprFrom:=From;
  543.   FSprDest:=Dest;
  544.   FSprTimeToRun:=TimeToRunSec/60.0/60.0/24.0;
  545.   FSprMoveVect:=SprMakeVect(FSprFrom,FSprDest);
  546.   FSprTimeStarted:=time;
  547.   FSprToShow:=True;
  548.   FSprRunning := True;
  549.   end;
  550.  
  551. procedure TMChSprite.SprCruise(TimeToRunSec: TDateTime);
  552.   begin
  553.   if not FSprSet then SprInit;
  554.   if FSprRunning then SprStop;
  555.   FSprTimeToRun:=TimeToRunSec/60.0/60.0/24.0;
  556.   FSprTimeStarted:=time;
  557.   FSprCruise:=True;
  558.   FSprToShow:=True;
  559.   FSprRunning := True;
  560.   end;
  561.  
  562. procedure TMChSprite.SprRun(From,Dest: TPoint; TimeToRunSec: TDateTime);
  563.   var
  564.     SNew : TBitmap;
  565.     RcOld,RcB: TRect;
  566.     PosNew:TPoint;
  567.     i:cardinal;
  568.     Done: Boolean;
  569.     WasOnCanvas: Boolean;
  570.  
  571.   begin
  572.   if not FSprSet then SprInit;
  573.   if FSprRunning then SprStop;
  574.   WasOnCanvas:=FSprOnCanvas;
  575.   if FSprOnCanvas then SprHide;
  576.   if FSprOnCanvas or FSprInBuf then
  577.     begin
  578.     PSpriteMgr.BgrAppIdle(Self,Done);
  579.     PSpriteMgr.BgrUpdateDirtyRegToCanvas(DirtyReg(NulRect,FSprCurrentRect));
  580.     end;
  581.   PSpriteMgr.BgrPause:=True;
  582.   if (not FSprRunning) and (not FSprInBuf) and (not FSprOnCanvas) then
  583.     begin
  584.     SNew:=TBitmap.Create;
  585.     SNew.Width:=Width;
  586.     SNew.Height:=Height;
  587.     SNew.Canvas.CopyMode:=cmSrcCopy;
  588.     RcB:=Rect(0,0,Width,Height);
  589.     FSprFrom:=From;
  590.     FSprDest:=Dest;
  591.     FSprTimeToRun:=TimeToRunSec/60.0/60.0/24.0;
  592.     FSprMoveVect:=SprMakeVect(FSprFrom,FSprDest);
  593.     Left:=SprRefToLeftTop(From).x;
  594.     Top :=SprRefToLeftTop(From).y;
  595.     FSprCurrentRect:=Rect(Left,Top,Left+Width,Top+Height);
  596.     FSprNextPos:=From;
  597.     FSprMoved:=False;
  598.     FSprTimeStarted:=time;
  599.     FSprRunning:=True;
  600.     repeat
  601.       RcOld:=FSprCurrentRect;
  602.       FSprTimeRunning:=time-FSprTimeStarted;
  603.       PosNew:=SprDesiredPos(time);
  604.       if FSprMoved then FSprMoved:=False;
  605.       Left:=SprRefToLeftTop(PosNew).x;
  606.       Top :=SprRefToLeftTop(PosNew).y;
  607.       FSprCurrentRect:=Rect(Left,Top,Left+Width,Top+Height);
  608.       FSprNextPos:=PosNew;
  609.       {SNew.Canvas.CopyRect(RcB,PSpriteMgr.BgrScreenBuf.Canvas,FSprCurrentRect);}
  610.       PSpriteMgr.BgrScreenBufGetRect(RcB,SNew,FSprCurrentRect);
  611.       {
  612.       PSpriteMgr.BgrScreenBuf.Canvas.CopyMode := cmSrcAnd;
  613.       PSpriteMgr.BgrScreenBuf.Canvas.Draw(Point(Left,Top),FSprMask);
  614.       PSpriteMgr.BgrScreenBuf.Canvas.CopyMode := cmSrcPaint;
  615.       PSpriteMgr.BgrScreenBuf.Canvas.Draw(Point(Left,Top),FSprBitmap);
  616.       }
  617.       PSpriteMgr.BgrScreenBufDrawMaskPaint(Point(Left,Top),FSprMask,FSprBitmap);
  618.       FSprInBuf:=True;
  619.       {SprUpdateDirtyReg(RcOld,FSprCurrentRect);}
  620.       PSpriteMgr.BgrUpdateDirtyRegToCanvas(DirtyReg(RcOld,FSprCurrentRect));
  621.       {
  622.       PSpriteMgr.BgrScreenBuf.Canvas.CopyMode := cmSrcCopy;
  623.       PSpriteMgr.BgrScreenBuf.Canvas.Draw(Left,Top,SNew);
  624.       }
  625.       PSpriteMgr.BgrScreenBufDrawRect(Point(Left,Top),SNew);
  626.       FSprInBuf:=False;
  627.       until FSprTimeRunning>=FSprTimeToRun;
  628.     if SprHideAfter then PSpriteMgr.BgrUpdateDirtyReg(DirtyReg(NulRect,FSprCurrentRect))
  629.     {PSpriteMgr.SprUpdateDirtyReg(NulRect,FSprCurrentRect)}
  630.     else
  631.       begin
  632.       {
  633.       PSpriteMgr.BgrScreenBuf.Canvas.CopyMode := cmSrcAnd;
  634.       PSpriteMgr.BgrScreenBuf.Canvas.Draw(Left,Top,FSprMask);
  635.       PSpriteMgr.BgrScreenBuf.Canvas.CopyMode := cmSrcPaint;
  636.       PSpriteMgr.BgrScreenBuf.Canvas.Draw(Left,Top,FSprBitmap);
  637.       }
  638.       PSpriteMgr.BgrScreenBufDrawMaskPaint(Point(Left,Top),FSprMask,FSprBitmap);
  639.       FSprInBuf:=True;
  640.       FSprOnCanvas:=False;
  641.       FSprToShow:=True;
  642.       end;
  643.     FSprRunning:=False;
  644.     FSprNextPos:=PosNew;
  645.     PSpriteMgr.BgrPause:=False;
  646.     if WasOnCanvas and not SprHideAfter then
  647.       begin
  648.       SprShowAt(FSprNextPos);
  649.       end;
  650.     SNew.Free;
  651.     end;
  652.   end;
  653.  
  654. function TMChSprite.SprMakeVect(From, Dest: TPoint):TPoint;
  655.   begin
  656.   SprMakeVect:=Point( Dest.x-From.x, Dest.y-From.y );
  657.   end;
  658.  
  659. function TMChSprite.SprDesiredPos(AtTime: TDateTime):TPoint;
  660.   var
  661.     RTime: TDateTime;
  662.   begin
  663.   RTime:=AtTime-FSprTimeStarted;
  664.   if (not FSprRunning) then
  665.     begin
  666.     if not FSprMoved then SprDesiredPos:=SprLeftTopToRef(Point(Left,Top))
  667.     else
  668.       begin
  669.       SprDesiredPos:=SprNextPos;
  670.       end;
  671.     end
  672.   else
  673.     begin
  674.     if FSprCruise and (FSprTimeToRun>=0) and (RTime>FSprTimeToRun) then FSprCruise:=False;
  675.     if FSprCruise and Assigned(FSprPosFunc) and ((FSprTimeToRun<0) or (RTime<FSprTimeToRun)) then
  676.       begin
  677.       if FSprPaused then 
  678.         begin
  679.         FSprPosFunc(AtTime);
  680.         SprDesiredPos:=SprNextPos;
  681.         end
  682.       else SprDesiredPos:=FSprPosFunc(AtTime);
  683.       end
  684.     else
  685.       begin
  686.       if FSprPaused then SprDesiredPos:=SprNextPos
  687.       else
  688.         begin
  689.         if RTime<=0 then
  690.           SprDesiredPos:=SprFrom
  691.         else
  692.           if (FSprTimeToRun>0) and (RTime<FSprTimeToRun) then
  693.             SprDesiredPos:=Point(
  694.               FSprFrom.x+trunc(RTime/FSprTimeToRun*FSprMoveVect.x),
  695.               FSprFrom.y+trunc(RTime/FSprTimeToRun*FSprMoveVect.y) )
  696.           else
  697.             SprDesiredPos:=SprDest;
  698.           end;
  699.       end;
  700.     end;
  701.   end;
  702.  
  703. function  TMChSprite.SprHitTest(ScrP: TPoint): Boolean;
  704.   var
  705.     PTmp, PTmp2: TPoint;
  706.   begin
  707.   SprHitTest:=False;
  708.   if (FSprOnCanvas) and (InRect(ScrP, FSprCurrentRect) ) then
  709.     begin
  710.     if (SprScaleX<>0) and (SprScaleY<>0) then
  711.       begin
  712.       PTmp:=Point(ScrP.x-left-round(SprScaleX*SprRefX),ScrP.y-Top-round(SprScaleY*SprRefY));
  713.       PTmp2:=Point( round(PTmp.x/abs(SprScaleX))+SprRefX,round(PTmp.y/abs(SprScaleY))+SprRefY );
  714.       if (FSprMask.Canvas.Pixels[PTmp2.x,PTmp2.y]=clBlack) and
  715.          (FSprBitmap.Canvas.Pixels[PTmp2.x,PTmp2.y]<>clBlack) then
  716.         SprHitTest:=True;
  717.       end
  718.     else
  719.       begin
  720.       SprHitTest:=True;
  721.       end;
  722.     end;
  723.   end;
  724.  
  725. function  TMChSprite.SprHitAt(ScrP: TPoint): TPoint;
  726.   var
  727.     PTmp, PTmp2: TPoint;
  728.   begin
  729.   if SprHitTest(ScrP) then
  730.     begin
  731.     PTmp:=Point(ScrP.x-left-round(SprScaleX*SprRefX),ScrP.y-Top-round(SprScaleY*SprRefY));
  732.     PTmp2:=Point( round(PTmp.x),round(PTmp.y) );
  733.     SprHitAt:=PTmp2;
  734.     end
  735.   else
  736.     SprHitAt:=NulPoint;
  737.   end;
  738.  
  739. procedure TMChSprite.SprSetScaleX(NewScaleX: double);
  740.   begin
  741.   FSprScaleX:=NewScaleX;
  742.   FSprRescale:=True;
  743.   FSprMoved:=True;
  744.   end;
  745.  
  746. procedure TMChSprite.SprSetScaleY(NewScaleY: double);
  747.   begin
  748.   FSprScaleY:=NewScaleY;
  749.   FSprRescale:=True;
  750.   FSprMoved:=True;
  751.   end;
  752.  
  753. procedure TMChSprite.SprSetScale(NewScale: double);
  754.   begin
  755.   FSprScaleX:=NewScale;
  756.   FSprScaleY:=NewScale;
  757.   FSprRescale:=True;
  758.   FSprMoved:=True;
  759.   end;
  760.  
  761. procedure TMChSprite.SprSetRefX(NewRefX: Integer);
  762.   begin
  763.   FSprRefX:=NewRefX;
  764.   FSprRescale:=True;
  765.   FSprMoved:=True;
  766.   end;
  767.  
  768. procedure TMChSprite.SprSetRefY(NewRefY: Integer);
  769.   begin
  770.   FSprRefY:=NewRefY;
  771.   FSprRescale:=True;
  772.   FSprMoved:=True;
  773.   end;
  774.  
  775. procedure TMChSprite.SprSetRef(NewRef: TPoint);
  776.   begin
  777.   FSprRefX:=NewRef.x;
  778.   FSprRefY:=NewRef.y;
  779.   FSprRescale:=True;
  780.   FSprMoved:=True;
  781.   end;
  782.  
  783. function  TMChSprite.SprRefToLeftTop(ScrP: TPoint): TPoint;
  784.   begin
  785.   SprRefToLeftTop:=Point(ScrP.x-round(SprScaleX*SprRefX),ScrP.y-round(SprScaleY*SprRefY));
  786.   end;
  787.  
  788. function  TMChSprite.SprLeftTopToRef(ScrP: TPoint): TPoint;
  789.   begin
  790.   SprLeftTopToRef:=Point(ScrP.x+round(SprScaleX*SprRefX),ScrP.y+round(SprScaleY*SprRefY));
  791.   end;
  792.  
  793. function  TMChSprite.SprCheckCollision(TestSpr: TMChSprite; AtTime: TDateTime): Boolean;
  794.   var
  795.     TestPos, MyPos: TPoint;
  796.     Dist, MyRad, TestRad, alpha: double;
  797.   begin
  798.   SprCheckCollision:=False;
  799.   if FSprColliding and TestSpr.SprColliding then
  800.     begin
  801.     MyPos:=SprDesiredPos(AtTime);
  802.     TestPos:=TestSpr.SprDesiredPos(AtTime);
  803.     if (abs(MyPos.x-TestPos.x)<=(abs(SprScaleX*SprRadiusX)+abs(TestSpr.SprScaleX*TestSpr.SprRadiusX))) and
  804.        (abs(MyPos.y-TestPos.y)<=(abs(SprScaleY*SprRadiusY)+abs(TestSpr.SprScaleY*TestSpr.SprRadiusY))) then
  805.       begin
  806.       if (SprRadiusX<0) and (TestSpr.SprRadiusX<0) then SprCheckCollision:=True
  807.       else
  808.         begin
  809.         Dist:=sqrt( (1.0*(MyPos.x-TestPos.x))*(1.0*(MyPos.x-TestPos.x))+
  810.                     (1.0*(MyPos.y-TestPos.y))*(1.0*(MyPos.y-TestPos.y))+1.0e-6 );
  811.         if abs(MyPos.x-TestPos.x)<1 then alpha:=0 else
  812.           alpha:=arctan( abs( (MyPos.y-TestPos.y)/(MyPos.x-TestPos.x) ) );
  813.         MyRad  := sqrt( abs(SprScaleX*SprRadiusX)*sin(alpha)*abs(SprScaleX*SprRadiusX)*sin(alpha)+
  814.                         abs(SprScaleY*SprRadiusY)*cos(alpha)*abs(SprScaleY*SprRadiusY)*cos(alpha) );
  815.         TestRad:= sqrt( abs(TestSpr.SprScaleX*TestSpr.SprRadiusX)*sin(alpha)*
  816.                         abs(TestSpr.SprScaleX*TestSpr.SprRadiusX)*sin(alpha)+
  817.                         abs(TestSpr.SprScaleY*TestSpr.SprRadiusY)*cos(alpha)*
  818.                         abs(TestSpr.SprScaleY*TestSpr.SprRadiusY)*cos(alpha) );
  819.         if Dist<MyRad+TestRad then SprCheckCollision:=True;
  820.         end;
  821.       end;
  822.     end;
  823.   end;
  824.  
  825. function  TMChSprite.SprCheckBorders(AtTime: TDateTime): Boolean;
  826.   var
  827.     TestPos, MyPos: TPoint;
  828.     Dist, MyRad, TestRad, alpha: double;
  829.   begin
  830.   SprCheckBorders:=False;
  831.   if FSprColliding then
  832.     begin
  833.     MyPos:=SprDesiredPos(AtTime);
  834.     if (MyPos.x-abs(SprScaleX*SprRadiusX)<=0) or
  835.        (MyPos.x+abs(SprScaleX*SprRadiusX)>=PSpriteMgr.ClientWidth) or   
  836.        (MyPos.y-abs(SprScaleY*SprRadiusY)<=0) or
  837.        (MyPos.y+abs(SprScaleY*SprRadiusy)>=PSpriteMgr.ClientHeight) then
  838.        SprCheckBorders:=True;
  839.     end;
  840.   end;
  841.  
  842. end.
  843.